home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / cg68k2.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  99KB  |  2,147 lines
  1. {
  2.     $Id: cg68k2.pas,v 1.2.2.5 1998/08/18 13:51:45 carl Exp $
  3.     Copyright (c) 1993-98 by Florian Klaempfl, Carl Eric Codere
  4.  
  5.     This unit generates 68000 (or better) assembler from the parse tree
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23.  
  24. {$ifdef tp}
  25.   {$E+,F+,N+,D+,L+,Y+}
  26. {$endif}
  27. Unit Cg68k2;
  28.  
  29. Interface
  30.  
  31.     uses
  32.        objects,verbose,cobjects,systems,globals,tree,
  33.        symtable,types,strings,pass_1,hcodegen,
  34.        aasm,m68k,tgen68k,files,cga68k;
  35.  
  36.       const
  37.  
  38.        { process condition codes bit definitions }
  39.        CARRY_FLAG    = $01;
  40.        OVFL_FLAG     = $02;
  41.        ZERO_FLAG     = $04;
  42.        NEG_FLAG      = $08;
  43.        { to set OR with flags     }
  44.        { to clear AND (NOT flag)  }
  45.  
  46.  
  47.     procedure secondadd(var p : ptree);
  48.     procedure processcc(p: ptree);
  49.     procedure secondfor(var p : ptree);
  50.     procedure secondas(var p : ptree);
  51.     procedure secondraise(var p : ptree);
  52.     procedure secondin(var p : ptree);
  53.     procedure secondexpr(var p : ptree);
  54.     procedure secondblockn(var p : ptree);
  55.     procedure second_while_repeatn(var p : ptree);
  56.     procedure secondifn(var p : ptree);
  57.     procedure secondbreakn(var p : ptree);
  58.     { copies p a set element into the d0.b register }
  59.     procedure loadsetelement(var p : ptree);
  60.  
  61. Implementation
  62.  
  63.     uses cg68k;
  64.  
  65.  
  66.     procedure secondadd(var p : ptree);
  67.  
  68.     { is also being used for xor, and "mul", "sub, or and comparative }
  69.     { operators                                                       }
  70.  
  71.       label do_normal;
  72.       var
  73.          swapp : ptree;
  74.          hregister : tregister;
  75.          pushed,mboverflow,cmpop : boolean;
  76.          op : tasmop;
  77.          pushedregs : tpushed;
  78.          flags : tresflags;
  79.          otl,ofl : plabel;
  80.          power : longint;
  81.          href : treference;
  82.          opsize : topsize;
  83.          swapl : tlocation;
  84.          tmpref: treference;
  85.          { true, if unsigned types are compared }
  86.          unsigned : boolean;
  87.  
  88.           { is_in_dest if the result is put directly into }
  89.           { the resulting refernce or varregister }
  90.            { true, if a small set is handled with the longint code }
  91.           is_set : boolean;
  92.           is_in_dest : boolean;
  93.            { true, if for sets subtractions the extra not should generated }
  94.            extra_not : boolean;
  95.  
  96.       begin
  97.          unsigned:=false;
  98.          is_in_dest := false;
  99.          extra_not:=false;
  100.  
  101.          opsize:=S_L;
  102.  
  103.          { calculate the operator which is more difficult }
  104.          firstcomplex(p);
  105.          { handling boolean expressions extra: }
  106.          if ((p^.left^.resulttype^.deftype=orddef) and
  107.             (porddef(p^.left^.resulttype)^.typ=bool8bit)) then
  108. {            ((p^.right^.resulttype^.deftype=orddef) and
  109.             (porddef(p^.right^.resulttype)^.typ=bool8bit)) then }
  110.            begin
  111.               if (p^.treetype=andn) or (p^.treetype=orn) then
  112.                 begin
  113.                    p^.location.loc:=LOC_JUMP;
  114.                    cmpop:=false;
  115.                    case p^.treetype of
  116.                      andn : begin
  117.                                otl:=truelabel;
  118.                                getlabel(truelabel);
  119.                                secondpass(p^.left);
  120.                                maketojumpbool(p^.left);
  121.                                emitl(A_LABEL,truelabel);
  122.                                truelabel:=otl;
  123.                             end;
  124.                      orn : begin
  125.                               ofl:=falselabel;
  126.                               getlabel(falselabel);
  127.                               secondpass(p^.left);
  128.                               maketojumpbool(p^.left);
  129.                               emitl(A_LABEL,falselabel);
  130.                               falselabel:=ofl;
  131.                            end;
  132.                      else Message(sym_e_type_mismatch);
  133.                    end; { end case }
  134.                   secondpass(p^.right);
  135.                   maketojumpbool(p^.right);
  136.                 end { endif }
  137.               else if p^.treetype in [unequaln,equaln,xorn] then
  138.                 begin
  139.                    opsize:=S_B;
  140.                    if p^.left^.treetype=ordconstn then
  141.                      begin
  142.                         swapp:=p^.right;
  143.                         p^.right:=p^.left;
  144.                         p^.left:=swapp;
  145.                         p^.swaped:=not(p^.swaped);
  146.                      end;
  147.                    secondpass(p^.left);
  148.                    p^.location:=p^.left^.location;
  149.                    (* register needed *)
  150.                    pushed:=maybe_push(p^.right^.registers32,p);
  151.                    secondpass(p^.right);
  152.                    if pushed then restore(p);
  153.                    goto do_normal;
  154.                 end { endif }
  155.               else Message(sym_e_type_mismatch);
  156.            end { endif }
  157.          { also handle string operations seperately }
  158.          else if (p^.left^.resulttype^.deftype=stringdef) then
  159.            begin
  160.               { string operations are not commutative }
  161.               if p^.swaped then
  162.                 begin
  163.                    swapp:=p^.left;
  164.                    p^.left:=p^.right;
  165.                    p^.right:=swapp;
  166.                    { because of jump being produced at comparison below: }
  167.                    p^.swaped:=not(p^.swaped);
  168.                 end;
  169.               case p^.treetype of
  170.                  addn : begin
  171.                            cmpop:=false;
  172.                            secondpass(p^.left);
  173.                            if (p^.left^.treetype<>addn) then
  174.                              begin
  175.                                 { can only reference be }
  176.                                 { string in register would be funny    }
  177.                                 { therefore produce a temporary string }
  178.  
  179.                                 { release the registers }
  180.                                 del_reference(p^.left^.location.reference);
  181.                                 gettempofsizereference(256,href);
  182.                                 copystring(href,p^.left^.location.reference,255);
  183.                                 ungetiftemp(p^.left^.location.reference);
  184.  
  185.                                 { does not hurt: }
  186.                                 p^.left^.location.loc:=LOC_MEM;
  187.                                 p^.left^.location.reference:=href;
  188.                              end;
  189.  
  190.                            secondpass(p^.right);
  191.  
  192.                            { on the right we do not need the register anymore too }
  193.                            del_reference(p^.right^.location.reference);
  194.                            pushusedregisters(pushedregs,$ffff);
  195.                            { WE INVERSE THE PARAMETERS!!! }
  196.                            { Because parameters are inversed in the rtl }
  197.                            emitpushreferenceaddr(p^.right^.location.reference);
  198.                            emitpushreferenceaddr(p^.left^.location.reference);
  199.                            emitcall('STRCONCAT',true);
  200.                            maybe_loadA5;
  201.                            popusedregisters(pushedregs);
  202.                            set_location(p^.location,p^.left^.location);
  203.                            ungetiftemp(p^.right^.location.reference);
  204.                         end; { this case }
  205.               ltn,lten,gtn,gten,
  206.                 equaln,unequaln :
  207.                         begin
  208.                            secondpass(p^.left);
  209.                            { are too few registers free? }
  210.                            pushed:=maybe_push(p^.right^.registers32,p);
  211.                            secondpass(p^.right);
  212.                            if pushed then restore(p);
  213.                            cmpop:=true;
  214.                            del_reference(p^.right^.location.reference);
  215.                            del_reference(p^.left^.location.reference);
  216.                            { generates better code }
  217.                            { s='' and s<>''        }
  218.                            if (p^.treetype in [equaln,unequaln]) and
  219.                              (
  220.                                ((p^.left^.treetype=stringconstn) and
  221.                                 (p^.left^.values^='')) or
  222.                                ((p^.right^.treetype=stringconstn) and
  223.                                 (p^.right^.values^=''))
  224.                              ) then
  225.                              begin
  226.                                 { only one node can be stringconstn }
  227.                                 { else pass 1 would have evaluted   }
  228.                                 { this node                         }
  229.                                 if p^.left^.treetype=stringconstn then
  230.                                   exprasmlist^.concat(new(pai68k,op_ref(
  231.                                     A_TST,S_B,newreference(p^.right^.location.reference))))
  232.                                 else
  233.                                   exprasmlist^.concat(new(pai68k,op_ref(
  234.                                     A_TST,S_B,newreference(p^.left^.location.reference))));
  235.                              end
  236.                            else
  237.                              begin
  238.                                pushusedregisters(pushedregs,$ffff);
  239.  
  240.                                { parameters are directly passed via registers       }
  241.                                { this has several advantages, no loss of the flags  }
  242.                                { on exit ,and MUCH faster on m68k machines          }
  243.                                {  speed difference (68000)                          }
  244.                                {   normal routine: entry, exit code + push  = 124   }
  245.                                {   (best case)                                      }
  246.                                {   assembler routine: param setup (worst case) = 48 }
  247.  
  248.                                exprasmlist^.concat(new(pai68k,op_ref_reg(
  249.                                     A_LEA,S_L,newreference(p^.left^.location.reference),R_A0)));
  250.                                exprasmlist^.concat(new(pai68k,op_ref_reg(
  251.                                     A_LEA,S_L,newreference(p^.right^.location.reference),R_A1)));
  252. {
  253.                                emitpushreferenceaddr(p^.left^.location.reference);
  254.                                emitpushreferenceaddr(p^.right^.location.reference); }
  255.                                emitcall('STRCMP',true);
  256.                                maybe_loada5;
  257.                                popusedregisters(pushedregs);
  258.                           end;
  259.                            ungetiftemp(p^.left^.location.reference);
  260.                            ungetiftemp(p^.right^.location.reference);
  261.                         end; { end this case }
  262.                 else Message(sym_e_type_mismatch);
  263.               end; { end case }
  264.            end { end else if }
  265.          else
  266.            begin
  267.               { in case of constant put it to the left }
  268.               if p^.left^.treetype=ordconstn then
  269.                 begin
  270.                    swapp:=p^.right;
  271.                    p^.right:=p^.left;
  272.                    p^.left:=swapp;
  273.                    p^.swaped:=not(p^.swaped);
  274.                 end;
  275.               secondpass(p^.left);
  276.               set_location(p^.location,p^.left^.location);
  277.               { are to few registers free? }
  278.               pushed:=maybe_push(p^.right^.registers32,p);
  279.               secondpass(p^.right);
  280.               if pushed then restore(p);
  281.               if (p^.left^.resulttype^.deftype=pointerdef) or
  282.  
  283.                  (p^.right^.resulttype^.deftype=pointerdef) or
  284.  
  285.                  ((p^.right^.resulttype^.deftype=objectdef) and
  286.                   pobjectdef(p^.right^.resulttype)^.isclass and
  287.                  (p^.left^.resulttype^.deftype=objectdef) and
  288.                   pobjectdef(p^.left^.resulttype)^.isclass
  289.                  ) or
  290.  
  291.                  (p^.left^.resulttype^.deftype=classrefdef) or
  292.  
  293.                  (p^.left^.resulttype^.deftype=procvardef) or
  294.  
  295.                  (p^.left^.resulttype^.deftype=enumdef) or
  296.  
  297.                  ((p^.left^.resulttype^.deftype=orddef) and
  298.                  (porddef(p^.left^.resulttype)^.typ=s32bit)) or
  299.                  ((p^.right^.resulttype^.deftype=orddef) and
  300.                  (porddef(p^.right^.resulttype)^.typ=s32bit)) or
  301.  
  302.                 ((p^.left^.resulttype^.deftype=orddef) and
  303.                  (porddef(p^.left^.resulttype)^.typ=u32bit)) or
  304.                  ((p^.right^.resulttype^.deftype=orddef) and
  305.                  (porddef(p^.right^.resulttype)^.typ=u32bit))
  306.  
  307.                  { SMALL SETS DO NOT WORK BECAUSE OF ENDIAN! }
  308.               or  { as well as small sets }
  309.                 ((p^.left^.resulttype^.deftype=setdef) and
  310.                  (psetdef(p^.left^.resulttype)^.settype=smallset))
  311.                  then
  312.                 begin
  313.            do_normal:
  314.                    mboverflow:=false;
  315.                    cmpop:=false;
  316.                    if (p^.left^.resulttype^.deftype=pointerdef) or
  317.                       (p^.right^.resulttype^.deftype=pointerdef) or
  318.                       ((p^.left^.resulttype^.deftype=orddef) and
  319.                       (porddef(p^.left^.resulttype)^.typ=u32bit)) or
  320.                       ((p^.right^.resulttype^.deftype=orddef) and
  321.                       (porddef(p^.right^.resulttype)^.typ=u32bit)) then
  322.                      unsigned:=true;
  323.                    is_set:=p^.resulttype^.deftype=setdef;
  324.  
  325.                    case p^.treetype of
  326.                       addn : begin
  327.                                 if is_set then
  328.                                   begin
  329.                                      op:=A_OR;
  330.                                      mboverflow:=false;
  331.                                      unsigned:=false;
  332.                                   end
  333.                                 else
  334.                                   begin
  335.                                      op:=A_ADD;
  336.                                      mboverflow:=true;
  337.                                   end;
  338.                              end; { end this case }
  339.                         symdifn : begin
  340.                                   { the symetric diff is only for sets }
  341.                                   if is_set then
  342.                                     begin
  343.                                        op:=A_EOR;
  344.                                        mboverflow:=false;
  345.                                        unsigned:=false;
  346.                                     end
  347.                                   else
  348.                                     begin
  349.                                        Message(sym_e_type_mismatch);
  350.                                     end;
  351.                                end;
  352.  
  353.                       muln : begin
  354.                                 if is_set then
  355.                                   begin
  356.                                      op:=A_AND;
  357.                                      mboverflow:=false;
  358.                                      unsigned:=false;
  359.                                   end
  360.                                 else
  361.                                   begin
  362.                                      if unsigned then
  363.                                        op:=A_MULU
  364.                                      else
  365.                                        op:=A_MULS;
  366.                                      mboverflow:=true;
  367.                                   end;
  368.                              end; { end this case }
  369.                       subn : begin
  370.                                 if is_set then
  371.                                   begin
  372.                                      op:=A_AND;
  373.                                      mboverflow:=false;
  374.                                      unsigned:=false;
  375.                                      extra_not:=true;
  376.                                   end
  377.                                 else
  378.                                   begin
  379.                                      op:=A_SUB;
  380.                                      mboverflow:=true;
  381.                                   end;
  382.                              end; {end this case }
  383.                       ltn,lten,gtn,gten,
  384.                       equaln,unequaln :
  385.                              begin
  386.                                 op:=A_CMP;
  387.                                 cmpop:=true;
  388.                              end;
  389.                       xorn : op:=A_EOR;
  390.                       orn : op:=A_OR;
  391.                       andn : op:=A_AND;
  392.                       else Message(sym_e_type_mismatch);
  393.                    end; {end case }
  394.                    { left and right no register?  }
  395.                    { then one must be demanded    }
  396.                    if (p^.left^.location.loc<>LOC_REGISTER) and
  397.                      (p^.right^.location.loc<>LOC_REGISTER) then
  398.                      begin
  399.                         { register variable ? }
  400.                         if (p^.left^.location.loc=LOC_CREGISTER) then
  401.                           begin
  402.                                { it is OK if this is the destination }
  403.                                if is_in_dest then
  404.                                  begin
  405.                                     hregister:=p^.location.register;
  406.                                     emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
  407.                                       hregister);
  408.                                  end
  409.                                else
  410.                              if cmpop then
  411.                                begin
  412.                                   { do not disturb the register }
  413.                                   hregister:=p^.location.register;
  414.                                end
  415.                              else
  416.                                begin
  417.                                   hregister := getregister32;
  418.                                   emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
  419.                                     hregister);
  420.                                end
  421.                           end
  422.                         else
  423.                           begin
  424.                              del_reference(p^.left^.location.reference);
  425.                                if is_in_dest then
  426.                                  begin
  427.                                     hregister:=p^.location.register;
  428.                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
  429.                                     newreference(p^.left^.location.reference),hregister)));
  430.                                  end
  431.                                else
  432.                                  begin
  433.  
  434.                                  { first give free, then demand new register }
  435.                                  hregister := getregister32;
  436.                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
  437.                                    newreference(p^.left^.location.reference),
  438.                                     hregister)));
  439.                                  end;{ endif p^... }
  440.                           end;
  441.  
  442.                         p^.location.loc:=LOC_REGISTER;
  443.                         p^.location.register:=hregister;
  444.  
  445.                      end
  446.                    else
  447.                      { if on the right the register then swap }
  448.                      if (p^.right^.location.loc=LOC_REGISTER) then
  449.                        begin
  450.                           swap_location(p^.location,p^.right^.location);
  451.  
  452.                           { newly swapped also set swapped flag }
  453.                           p^.swaped:=not(p^.swaped);
  454.                        end;
  455.                    { endif p^...<> LOC_REGISTER }
  456.                    { at this point, p^.location.loc should be LOC_REGISTER }
  457.                    { and p^.location.register should be a valid register   }
  458.                    { containing the left result                    }
  459.                    if p^.right^.location.loc<>LOC_REGISTER then
  460.                      begin
  461.                         if (p^.treetype=subn) and p^.swaped then
  462.                           begin
  463.                              if p^.right^.location.loc=LOC_CREGISTER then
  464.                                begin
  465.                                   if extra_not then
  466.                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,opsize,p^.location.register)));
  467.  
  468.  
  469.                                   emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,R_D6);
  470.                                   emit_reg_reg(op,opsize,p^.location.register,R_D6);
  471.                                   emit_reg_reg(A_MOVE,opsize,R_D6,p^.location.register);
  472.                                end
  473.                              else
  474.                                begin
  475.                                   if extra_not then
  476.                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,opsize,p^.location.register)));
  477.  
  478.                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
  479.                                     newreference(p^.right^.location.reference),R_D6)));
  480.                                   exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,p^.location.register,R_D6)));
  481.                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,opsize,R_D6,p^.location.register)));
  482.                                   del_reference(p^.right^.location.reference);
  483.                                end;
  484.                           end
  485.                           { end subn ... }
  486.                         else
  487.                           begin
  488.                              if (p^.right^.treetype=ordconstn) and (op=A_CMP) and
  489.                                 (p^.right^.value=0) then
  490.                                   exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,p^.location.register)))
  491.                              else
  492.                                 if (p^.right^.treetype=ordconstn) and (op=A_MULS) and
  493.                                    (ispowerof2(p^.right^.value,power)) then
  494.                                   begin
  495.                                     if (power <= 8) then
  496.                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_ASL,opsize,power,
  497.                                          p^.location.register)))
  498.                                     else
  499.                                       begin
  500.                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,power,
  501.                                          R_D6)));
  502.                                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_ASL,opsize,R_D6,
  503.                                           p^.location.register)))
  504.                                       end;
  505.                                   end
  506.                              else
  507.                                begin
  508.                                   if (p^.right^.location.loc=LOC_CREGISTER) then
  509.                                     begin
  510.                                        if extra_not then
  511.                                          begin
  512.                                             emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D6);
  513.                                             exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,R_D6)));
  514.                                             emit_reg_reg(A_AND,S_L,R_D6,
  515.                                               p^.location.register);
  516.                                          end
  517.                                        else
  518.                                          begin
  519.                                             if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
  520.                                             { Emulation for MC68000 }
  521.                                             begin
  522.                                               emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
  523.                                                  R_D0);
  524.                                               emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
  525.                                               emitcall('LONGMUL',true);
  526.                                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
  527.                                             end
  528.                                             else
  529.                                             if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
  530.                                              Message(cg_f_32bit_not_supported_in_68000)
  531.                                             else
  532.                                               emit_reg_reg(op,opsize,p^.right^.location.register,
  533.                                                 p^.location.register);
  534.                                          end;
  535.                                     end
  536.                                   else
  537.                                     begin
  538.                                        if extra_not then
  539.                                          begin
  540.                                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
  541.                                               p^.right^.location.reference),R_D6)));
  542.                                             exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,R_D6)));
  543.                                             emit_reg_reg(A_AND,S_L,R_D6,
  544.                                               p^.location.register);
  545.                                          end
  546.                                        else
  547.                                          begin
  548.                                             if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
  549.                                             { Emulation for MC68000 }
  550.                                             begin
  551.                                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE, opsize,
  552.                                                  newreference(p^.right^.location.reference),R_D1)));
  553.                                               emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D0);
  554.                                               emitcall('LONGMUL',true);
  555.                                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
  556.                                             end
  557.                                             else
  558.                                             if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
  559.                                              Message(cg_f_32bit_not_supported_in_68000)
  560.                                             else
  561.                                             { When one of the source/destination is a memory reference  }
  562.                                             { and the operator is EOR, the we must load it into the     }
  563.                                             { value into a register first since only EOR reg,reg exists }
  564.                                             { on the m68k                                               }
  565.                                             if (op=A_EOR) then
  566.                                               begin
  567.                                                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
  568.                                                     p^.right^.location.reference),R_D0)));
  569.                                                 exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,R_D0,
  570.                                                     p^.location.register)));
  571.                                               end
  572.                                             else
  573.                                               exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,newreference(
  574.                                                 p^.right^.location.reference),p^.location.register)));
  575.                                          end;
  576.                                        del_reference(p^.right^.location.reference);
  577.                                     end;
  578.                                end;
  579.                           end;
  580.                      end
  581.                    else
  582.                      begin
  583.                         { when swapped another result register }
  584.                         if (p^.treetype=subn) and p^.swaped then
  585.                           begin
  586.                              if extra_not then
  587.                                exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
  588.  
  589.                              exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
  590.                                p^.location.register,p^.right^.location.register)));
  591.                                swap_location(p^.location,p^.right^.location);
  592.                                { newly swapped also set swapped flag }
  593.                                { just to maintain ordering           }
  594.                                p^.swaped:=not(p^.swaped);
  595.                           end
  596.                         else
  597.                           begin
  598.                              if extra_not then
  599.                                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.right^.location.register)));
  600.  
  601.                              if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
  602.                              { Emulation for MC68000 }
  603.                              begin
  604.                                emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
  605.                                R_D0);
  606.                                emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
  607.                                emitcall('LONGMUL',true);
  608.                                emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
  609.                              end
  610.                              else
  611.                              if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
  612.                               Message(cg_f_32bit_not_supported_in_68000)
  613.                              else
  614.  
  615.                                exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
  616.                                p^.right^.location.register,
  617.                                p^.location.register)));
  618.                           end;
  619.                            ungetregister32(p^.right^.location.register);
  620.                      end;
  621.  
  622.                    if cmpop then
  623.                         ungetregister32(p^.location.register);
  624.                    { only in case of overflow operations }
  625.                    { produce overflow code }
  626.                    if mboverflow then
  627.                      emitoverflowcheck(p);
  628.                end
  629. {*********************************************************************}
  630.               else if ((p^.left^.resulttype^.deftype=orddef) and
  631.                  (porddef(p^.left^.resulttype)^.typ=uchar)) then
  632.                 begin
  633.                    case p^.treetype of
  634.                       ltn,lten,gtn,gten,
  635.                       equaln,unequaln :
  636.                                 cmpop:=true;
  637.                       else Message(sym_e_type_mismatch);
  638.                    end;
  639.                    unsigned:=true;
  640.                    { left and right no register? }
  641.                    { the one must be demanded    }
  642.                    if (p^.location.loc<>LOC_REGISTER) and
  643.                      (p^.right^.location.loc<>LOC_REGISTER) then
  644.                      begin
  645.                         if p^.location.loc=LOC_CREGISTER then
  646.                           begin
  647.                              if cmpop then
  648.                                { do not disturb register }
  649.                                hregister:=p^.location.register
  650.                              else
  651.                                begin
  652.                                   hregister:=getregister32;
  653.                                   emit_reg_reg(A_MOVE,S_B,p^.location.register,
  654.                                     hregister);
  655.                                end;
  656.                           end
  657.                         else
  658.                           begin
  659.                              del_reference(p^.location.reference);
  660.  
  661.                              { first give free then demand new register }
  662.                              hregister:=getregister32;
  663.                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),
  664.                                hregister)));
  665.                           end;
  666.                         p^.location.loc:=LOC_REGISTER;
  667.                         p^.location.register:=hregister;
  668.                      end;
  669.  
  670.                    { now p always a register }
  671.  
  672.                    if (p^.right^.location.loc=LOC_REGISTER) and
  673.                       (p^.location.loc<>LOC_REGISTER) then
  674.                      begin
  675.                        swap_location(p^.location,p^.right^.location);
  676.  
  677.                         { newly swapped also set swapped flag }
  678.                         p^.swaped:=not(p^.swaped);
  679.                      end;
  680.                    if p^.right^.location.loc<>LOC_REGISTER then
  681.                      begin
  682.                         if p^.right^.location.loc=LOC_CREGISTER then
  683.                           begin
  684.                              emit_reg_reg(A_CMP,S_B,
  685.                                 p^.right^.location.register,p^.location.register);
  686.                           end
  687.                         else
  688.                           begin
  689.                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,S_B,newreference(
  690.                                 p^.right^.location.reference),p^.location.register)));
  691.                              del_reference(p^.right^.location.reference);
  692.                           end;
  693.                      end
  694.                    else
  695.                      begin
  696.                         emit_reg_reg(A_CMP,S_B,p^.right^.location.register,
  697.                           p^.location.register);
  698.                         ungetregister32(p^.right^.location.register);
  699.                      end;
  700.                    ungetregister32(p^.location.register);
  701.                 end
  702.  
  703.  
  704. {*********************************************************************}
  705.  
  706.               else if (p^.left^.resulttype^.deftype=floatdef) and
  707.                   (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
  708.                  begin
  709.                     { real constants to the left }
  710.                     if p^.left^.treetype=realconstn then
  711.                       begin
  712.                          swapp:=p^.right;
  713.                          p^.right:=p^.left;
  714.                          p^.left:=swapp;
  715.                          p^.swaped:=not(p^.swaped);
  716.                       end;
  717.                     cmpop:=false;
  718.                     case p^.treetype of
  719.                        addn : op:=A_FADD;
  720.                        muln : op:=A_FMUL;
  721.                        subn : op:=A_FSUB;
  722.                        slashn : op:=A_FDIV;
  723.                        ltn,lten,gtn,gten,
  724.                        equaln,unequaln : begin
  725.                                             op:=A_FCMP;
  726.                                             cmpop:=true;
  727.                                          end;
  728.                        else Message(sym_e_type_mismatch);
  729.                     end;
  730.  
  731.                     if (p^.left^.location.loc <> LOC_FPU) and
  732.                        (p^.right^.location.loc <> LOC_FPU) then
  733.                       begin
  734.                          { we suppose left in reference }
  735.                          del_reference(p^.left^.location.reference);
  736.                          { get a copy, since we don't want to modify the same }
  737.                          { node at the same time.                             }
  738.                          tmpref:=p^.left^.location.reference;
  739.                          if assigned(p^.left^.location.reference.symbol) then
  740.                            tmpref.symbol:=stringdup(p^.left^.location.reference.symbol^);
  741.  
  742.                          floatload(pfloatdef(p^.left^.resulttype)^.typ, tmpref,
  743.                            p^.left^.location);
  744.                          clear_reference(tmpref);
  745.                       end
  746.                     else
  747.                       begin
  748.                         if (p^.right^.location.loc = LOC_FPU)
  749.                         and(p^.left^.location.loc <> LOC_FPU) then
  750.                            begin
  751.                              swap_location(p^.left^.location, p^.right^.location);
  752.                              p^.swaped := not(p^.swaped);
  753.                            end
  754.                       end;
  755.  
  756.                    { ---------------- LEFT = LOC_FPUREG -------------------- }
  757.                        if ((p^.treetype =subn) or (p^.treetype = slashn)) and (p^.swaped) then
  758.                           {  fpu_reg =  right(FP1) / fpu_reg }
  759.                           {  fpu_reg = right(FP1) -  fpu_reg  }
  760.                           begin
  761.                              if (cs_fp_emulation in aktswitches) then
  762.                               begin
  763.                                { fpu_reg = right / D1 }
  764.                                { fpu_reg = right - D1 }
  765.                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));
  766.  
  767.  
  768.                                   { load value into D1 }
  769.                                   if p^.right^.location.loc <> LOC_FPU then
  770.                                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  771.                                        newreference(p^.right^.location.reference),R_D1)))
  772.                                   else
  773.                                      emit_reg_reg(A_MOVE,S_L,p^.right^.location.fpureg,R_D1);
  774.  
  775.                                   { probably a faster way to do this but... }
  776.                                   case op of
  777.                                    A_FADD: emitcall('SINGLE_ADD',true);
  778.                                    A_FMUL: emitcall('SINGLE_MUL',true);
  779.                                    A_FSUB: emitcall('SINGLE_SUB',true);
  780.                                    A_FDIV: emitcall('SINGLE_DIV',true);
  781.                                    A_FCMP: emitcall('SINGLE_CMP',true);
  782.                                   end;
  783.                                   if not cmpop then { only flags are affected with cmpop }
  784.                                      exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
  785.                                        p^.left^.location.fpureg)));
  786.  
  787.                                   { if this was a reference, then delete as it }
  788.                                   { it no longer required.                     }
  789.                                   if p^.right^.location.loc <> LOC_FPU then
  790.                                      del_reference(p^.right^.location.reference);
  791.                               end
  792.                              else
  793.                               begin
  794.  
  795.                                   if p^.right^.location.loc <> LOC_FPU then
  796.                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
  797.                                        getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
  798.                                       newreference(p^.right^.location.reference),
  799.                                       R_FP1)))
  800.                                   else
  801.                                     { FPm --> FPn must use extended precision }
  802.                                     emit_reg_reg(A_FMOVE,S_X,p^.right^.location.fpureg,R_FP1);
  803.  
  804.                                   { arithmetic expression performed in extended mode }
  805.                                   exprasmlist^.concat(new(pai68k,op_reg_reg(op,S_X,
  806.                                       p^.left^.location.fpureg,R_FP1)));
  807.  
  808.                                   { cmpop does not change any floating point register!! }
  809.                                   if not cmpop then
  810.                                        emit_reg_reg(A_FMOVE,S_X,R_FP1,p^.left^.location.fpureg)
  811. {                                       exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
  812.                                        getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
  813.                                        R_FP1,p^.left^.location.fpureg)))}
  814.                                   else
  815.                                   { process comparison, to make it compatible with the rest of the code }
  816.                                       processcc(p);
  817.  
  818.                                   { if this was a reference, then delete as it }
  819.                                   { it no longer required.                     }
  820.                                   if p^.right^.location.loc <> LOC_FPU then
  821.                                      del_reference(p^.right^.location.reference);
  822.                               end;
  823.                           end
  824.                        else { everything is in the right order }
  825.                          begin
  826.                            {  fpu_reg = fpu_reg / right }
  827.                            {  fpu_reg = fpu_reg - right }
  828.                            { + commutative ops }
  829.                            if cs_fp_emulation in aktswitches then
  830.                            begin
  831.  
  832.                              { load value into D7 }
  833.                              if p^.right^.location.loc <> LOC_FPU then
  834.                                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  835.                                  newreference(p^.right^.location.reference),R_D0)))
  836.                              else
  837.                                emit_reg_reg(A_MOVE,S_L,p^.right^.location.fpureg,R_D0);
  838.  
  839.                              emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D1);
  840.                              { probably a faster way to do this but... }
  841.                              case op of
  842.                                A_FADD: emitcall('SINGLE_ADD',true);
  843.                                A_FMUL: emitcall('SINGLE_MUL',true);
  844.                                A_FSUB: emitcall('SINGLE_SUB',true);
  845.                                A_FDIV: emitcall('SINGLE_DIV',true);
  846.                                A_FCMP: emitcall('SINGLE_CMP',true);
  847.                              end;
  848.                              if not cmpop then { only flags are affected with cmpop }
  849.                                exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
  850.                                  p^.left^.location.fpureg)));
  851.                              { if this was a reference, then delete as it }
  852.                              { it no longer required.                     }
  853.                              if p^.right^.location.loc <> LOC_FPU then
  854.                                del_reference(p^.right^.location.reference);
  855.                            end
  856.                            else
  857.                            begin
  858.                              if p^.right^.location.loc <> LOC_FPU then
  859.                                exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
  860.                                  getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
  861.                                  newreference(p^.right^.location.reference),R_FP1)))
  862.                              else
  863.                                emit_reg_reg(A_FMOVE,getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
  864.                                  p^.right^.location.fpureg,R_FP1);
  865.  
  866.                                emit_reg_reg(op,S_X,R_FP1,p^.left^.location.fpureg);
  867.  
  868.                                if cmpop then
  869.                                  processcc(p);
  870.  
  871.                              { if this was a reference, then delete as it }
  872.                              { it no longer required.                     }
  873.                              if p^.right^.location.loc <> LOC_FPU then
  874.                                del_reference(p^.right^.location.reference);
  875.  
  876.                            end
  877.                          end; { endif treetype = .. }
  878.  
  879.  
  880.                          if cmpop then
  881.                           begin
  882.                              if p^.swaped then
  883.                                  case p^.treetype of
  884.                                      equaln: flags := F_E;
  885.                                      unequaln: flags := F_NE;
  886.                                      ltn : flags := F_G;
  887.                                      lten : flags := F_GE;
  888.                                      gtn : flags := F_L;
  889.                                      gten: flags := F_LE;
  890.                                  end
  891.                              else
  892.                                  case p^.treetype of
  893.                                      equaln: flags := F_E;
  894.                                      unequaln : flags := F_NE;
  895.                                      ltn: flags := F_L;
  896.                                      lten : flags := F_LE;
  897.                                      gtn : flags := F_G;
  898.                                      gten: flags := F_GE;
  899.                                  end;
  900.                              p^.location.loc := LOC_FLAGS;
  901.                              p^.location.resflags := flags;
  902.                              cmpop := false;
  903.                           end
  904.                          else
  905.                          begin
  906.                              p^.location.loc := LOC_FPU;
  907.                              if p^.left^.location.loc = LOC_FPU then
  908.                              { copy fpu register result . }
  909.                              { HERE ON EXIT FPU REGISTER IS IN EXTENDED MODE! }
  910.                                 p^.location.fpureg := p^.left^.location.fpureg
  911.                              else
  912.                              begin
  913.                                InternalError(34);
  914.                              end;
  915.                          end;
  916.  
  917.                 end
  918. {*********************************************************************}
  919.               else if (p^.left^.resulttype^.deftype=setdef) then
  920.                 begin
  921.                    { not commutative }
  922.                    if p^.swaped then
  923.                      begin
  924.                         swapp:=p^.left;
  925.                         p^.left:=p^.right;
  926.                         p^.right:=swapp;
  927.                         { because of jump being produced by comparison }
  928.                         p^.swaped:=not(p^.swaped);
  929.                      end;
  930.                    case p^.treetype of
  931.                       equaln,unequaln : begin
  932.                                      cmpop:=true;
  933.                                      del_reference(p^.left^.location.reference);
  934.                                      del_reference(p^.right^.location.reference);
  935.                                      pushusedregisters(pushedregs,$ffff);
  936.  
  937. {                                     emitpushreferenceaddr(p^.right^.location.reference);
  938.                                      emitpushreferenceaddr(p^.left^.location.reference);}
  939.                                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  940.                                        newreference(p^.left^.location.reference),R_A0)));
  941.                                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  942.                                        newreference(p^.right^.location.reference),R_A1)));
  943.                                      emitcall('SET_COMP_SETS',true);
  944.                                      maybe_loada5;
  945.                                      popusedregisters(pushedregs);
  946.                                      ungetiftemp(p^.left^.location.reference);
  947.                                      ungetiftemp(p^.right^.location.reference);
  948.                                   end;
  949.  
  950.                       addn,subn,muln,symdifn : begin
  951.                                      cmpop:=false;
  952.                                      del_reference(p^.left^.location.reference);
  953.                                      del_reference(p^.right^.location.reference);
  954.                                      href.symbol:=nil;
  955.                                      pushusedregisters(pushedregs,$ffff);
  956.                                      gettempofsizereference(32,href);
  957.                                      emitpushreferenceaddr(href);
  958.                                      { wrong place !! was hard to find out
  959.                                      pushusedregisters(pushedregs,$ff);}
  960.                                      emitpushreferenceaddr(p^.right^.location.reference);
  961.                                      emitpushreferenceaddr(p^.left^.location.reference);
  962.                                      case p^.treetype of
  963.                                        subn : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
  964.                                          newcsymbol('SET_SUB_SETS',0))));
  965.                                        addn : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
  966.                                          newcsymbol('SET_ADD_SETS',0))));
  967.                                        muln : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
  968.                                          newcsymbol('SET_MUL_SETS',0))));
  969.                                        symdifn:
  970.                                               emitcall('SET_SYMDIF_SETS',true);
  971.                                      end;
  972.                                      maybe_loada5;
  973.                                      popusedregisters(pushedregs);
  974.                                      ungetiftemp(p^.left^.location.reference);
  975.                                      ungetiftemp(p^.right^.location.reference);
  976.                                      p^.location.loc:=LOC_MEM;
  977.                                      stringdispose(p^.location.reference.symbol);
  978.                                      p^.location.reference:=href;
  979.                                   end;
  980.                       else Message(sym_e_type_mismatch);
  981.                    end; { end case }
  982.                 end {else if begin }
  983.               else Message(sym_e_type_mismatch);
  984.            end; { endif }
  985.           if (p^.left^.resulttype^.deftype<>stringdef) and
  986.              not ((p^.left^.resulttype^.deftype=setdef) and
  987.                 (psetdef(p^.left^.resulttype)^.settype<>smallset)) then
  988.             begin
  989.                { this can be useful if for instance length(string) is called }
  990.                if (p^.left^.location.loc=LOC_REFERENCE) or
  991.                   (p^.left^.location.loc=LOC_MEM) then
  992.                  ungetiftemp(p^.left^.location.reference);
  993.                if (p^.right^.location.loc=LOC_REFERENCE) or
  994.                   (p^.right^.location.loc=LOC_MEM) then
  995.                  ungetiftemp(p^.right^.location.reference);
  996.             end;
  997.  
  998.          { in case of comparison operation the put result in the flags }
  999.          if cmpop then
  1000.            begin
  1001.               if not(unsigned) then
  1002.                 begin
  1003.                    if p^.swaped then
  1004.                      case p^.treetype of
  1005.                         equaln : flags:=F_E;
  1006.                         unequaln : flags:=F_NE;
  1007.                         ltn : flags:=F_G;
  1008.                         lten : flags:=F_GE;
  1009.                         gtn : flags:=F_L;
  1010.                         gten : flags:=F_LE;
  1011.                      end
  1012.                    else
  1013.                      case p^.treetype of
  1014.                         equaln : flags:=F_E;
  1015.                         unequaln : flags:=F_NE;
  1016.                         ltn : flags:=F_L;
  1017.                         lten : flags:=F_LE;
  1018.                         gtn : flags:=F_G;
  1019.                         gten : flags:=F_GE;
  1020.                      end;
  1021.                 end
  1022.               else
  1023.                 begin
  1024.                    if p^.swaped then
  1025.                      case p^.treetype of
  1026.                         equaln : flags:=F_E;
  1027.                         unequaln : flags:=F_NE;
  1028.                         ltn : flags:=F_A;
  1029.                         lten : flags:=F_AE;
  1030.                         gtn : flags:=F_B;
  1031.                         gten : flags:=F_BE;
  1032.                      end
  1033.                    else
  1034.                      case p^.treetype of
  1035.                         equaln : flags:=F_E;
  1036.                         unequaln : flags:=F_NE;
  1037.                         ltn : flags:=F_B;
  1038.                         lten : flags:=F_BE;
  1039.                         gtn : flags:=F_A;
  1040.                         gten : flags:=F_AE;
  1041.                      end;
  1042.                 end; { end begin }
  1043.               p^.location.loc:=LOC_FLAGS;
  1044.               p^.location.resflags:=flags;
  1045.            end; { endif cmpop }
  1046.       end;
  1047.  
  1048.  procedure processcc(p: ptree);
  1049.  var
  1050.    label1,label2: plabel;
  1051.  (*************************************************************************)
  1052.  (*  Description: This routine handles the conversion of Floating point   *)
  1053.  (*  condition codes to normal cpu condition codes.                       *)
  1054.  (*************************************************************************)
  1055.  begin
  1056.       getlabel(label1);
  1057.       getlabel(label2);
  1058.       case p^.treetype of
  1059.         equaln,unequaln: begin
  1060.                            { not equal clear zero flag }
  1061.                            emitl(A_FBEQ,label1);
  1062.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1063.                              A_AND, S_B, NOT ZERO_FLAG, R_CCR)));
  1064.                            emitl(A_BRA,label2);
  1065.                            emitl(A_LABEL,label1);
  1066.                            { equal - set zero flag }
  1067.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1068.                              A_OR,S_B, ZERO_FLAG, R_CCR)));
  1069.                            emitl(A_LABEL,label2);
  1070.                         end;
  1071.          ltn:           begin
  1072.                            emitl(A_FBLT,label1);
  1073.                            { not less than       }
  1074.                            { clear N and V flags }
  1075.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1076.                              A_AND, S_B, NOT (NEG_FLAG OR OVFL_FLAG), R_CCR)));
  1077.                            emitl(A_BRA,label2);
  1078.                            emitl(A_LABEL,label1);
  1079.                            { less than }
  1080.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1081.                              A_OR,S_B, NEG_FLAG, R_CCR)));
  1082.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1083.                              A_AND,S_B, NOT OVFL_FLAG, R_CCR)));
  1084.                            emitl(A_LABEL,label2);
  1085.                         end;
  1086.          gtn:           begin
  1087.                            emitl(A_FBGT,label1);
  1088.                            { not greater than }
  1089.                            { set Z flag       }
  1090.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1091.                              A_OR, S_B, ZERO_FLAG, R_CCR)));
  1092.                            emitl(A_BRA,label2);
  1093.                            emitl(A_LABEL,label1);
  1094.                            { greater than      }
  1095.                            { set N and V flags }
  1096.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1097.                              A_OR,S_B, NEG_FLAG OR OVFL_FLAG , R_CCR)));
  1098.                            emitl(A_LABEL,label2);
  1099.                         end;
  1100.          gten:           begin
  1101.                            emitl(A_FBGE,label1);
  1102.                            { not greater or equal }
  1103.                            { set N and clear V    }
  1104.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1105.                              A_AND, S_B, NOT OVFL_FLAG, R_CCR)));
  1106.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1107.                              A_OR,S_B, NEG_FLAG, R_CCR)));
  1108.                            emitl(A_BRA,label2);
  1109.                            emitl(A_LABEL,label1);
  1110.                            { greater or equal    }
  1111.                            { clear V and N flags }
  1112.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1113.                              A_AND, S_B, NOT (OVFL_FLAG OR NEG_FLAG), R_CCR)));
  1114.                            emitl(A_LABEL,label2);
  1115.                         end;
  1116.          lten:           begin
  1117.                            emitl(A_FBLE,label1);
  1118.                            { not less or equal }
  1119.                            { clear Z, N and V  }
  1120.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1121.                              A_AND, S_B, NOT (ZERO_FLAG OR NEG_FLAG OR OVFL_FLAG), R_CCR)));
  1122.                            emitl(A_BRA,label2);
  1123.                            emitl(A_LABEL,label1);
  1124.                            { less or equal     }
  1125.                            { set Z and N       }
  1126.                            { and clear V       }
  1127.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1128.                              A_OR,S_B, ZERO_FLAG OR NEG_FLAG, R_CCR)));
  1129.                            exprasmlist^.concat(new(pai68k, op_const_reg(
  1130.                              A_AND,S_B, NOT OVFL_FLAG, R_CCR)));
  1131.                            emitl(A_LABEL,label2);
  1132.                         end;
  1133.            else
  1134.              begin
  1135.                InternalError(34);
  1136.              end;
  1137.       end; { end case }
  1138.  end;
  1139.  
  1140.     procedure secondfor(var p : ptree);
  1141.  
  1142.       var
  1143.          l1,l3,oldclabel,oldblabel : plabel;
  1144.          omitfirstcomp,temptovalue : boolean;
  1145.          hs : byte;
  1146.          temp1 : treference;
  1147.          hop : tasmop;
  1148.          cmpreg,cmp32 : tregister;
  1149.          opsize : topsize;
  1150.          count_var_is_signed : boolean;
  1151.  
  1152.       begin
  1153.          oldclabel:=aktcontinuelabel;
  1154.          oldblabel:=aktbreaklabel;
  1155.          getlabel(aktcontinuelabel);
  1156.          getlabel(aktbreaklabel);
  1157.          getlabel(l3);
  1158.  
  1159.          { could we spare the first comparison ? }
  1160.          omitfirstcomp:=false;
  1161.          if p^.right^.treetype=ordconstn then
  1162.            if p^.left^.right^.treetype=ordconstn then
  1163.              omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
  1164.                or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
  1165.  
  1166.          { only calculate reference }
  1167.          cleartempgen;
  1168.          secondpass(p^.t2);
  1169.          if not(simple_loadn) then
  1170.           Message(cg_e_illegal_count_var);
  1171.  
  1172.          { produce start assignment }
  1173.          cleartempgen;
  1174.          secondpass(p^.left);
  1175.          count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
  1176.          hs:=p^.t2^.resulttype^.size;
  1177.          cmp32:=getregister32;
  1178.          cmpreg:=cmp32;
  1179.          case hs of
  1180.             1 : begin
  1181.                    opsize:=S_B;
  1182.                 end;
  1183.             2 : begin
  1184.                    opsize:=S_W;
  1185.                 end;
  1186.             4 : begin
  1187.                    opsize:=S_L;
  1188.                 end;
  1189.          end;
  1190.          cleartempgen;
  1191.          secondpass(p^.right);
  1192.          { calculate pointer value and check if changeable and if so }
  1193.          { load into temporary variable                              }
  1194.          if p^.right^.treetype<>ordconstn then
  1195.            begin
  1196.               temp1.symbol:=nil;
  1197.               gettempofsizereference(hs,temp1);
  1198.               temptovalue:=true;
  1199.               if (p^.right^.location.loc=LOC_REGISTER) or
  1200.                  (p^.right^.location.loc=LOC_CREGISTER) then
  1201.                 begin
  1202.                    exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,p^.right^.location.register,
  1203.                       newreference(temp1))));
  1204.                  end
  1205.               else
  1206.                  concatcopy(p^.right^.location.reference,temp1,hs,false);
  1207.            end
  1208.          else temptovalue:=false;
  1209.  
  1210.          if temptovalue then
  1211.            begin
  1212.               if p^.t2^.location.loc=LOC_CREGISTER then
  1213.                begin
  1214.                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
  1215.                      p^.t2^.location.register)));
  1216.                 end
  1217.               else
  1218.                 begin
  1219.                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
  1220.                      cmpreg)));
  1221.                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
  1222.                      cmpreg)));
  1223.                 end;
  1224.            end
  1225.          else
  1226.            begin
  1227.               if not(omitfirstcomp) then
  1228.                 begin
  1229.                    if p^.t2^.location.loc=LOC_CREGISTER then
  1230.                      exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
  1231.                        p^.t2^.location.register)))
  1232.                    else
  1233.                      exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
  1234.                newreference(p^.t2^.location.reference))));
  1235.                 end;
  1236.            end;
  1237.          if p^.backward then
  1238.           begin
  1239.            if count_var_is_signed then
  1240.               hop:=A_BLT
  1241.            else
  1242.               hop:=A_BCS;
  1243.           end
  1244.          else
  1245.            if count_var_is_signed then
  1246.              hop:=A_BGT
  1247.            else hop:=A_BHI;
  1248.  
  1249.          if not(omitfirstcomp) or temptovalue then
  1250.           emitl(hop,aktbreaklabel);
  1251.  
  1252.          emitl(A_LABEL,l3);
  1253.  
  1254.          { help register must not be in instruction block }
  1255.          cleartempgen;
  1256.          if assigned(p^.t1) then
  1257.            secondpass(p^.t1);
  1258.  
  1259.          emitl(A_LABEL,aktcontinuelabel);
  1260.  
  1261.          { makes no problems there }
  1262.          cleartempgen;
  1263.  
  1264.          { demand help register again }
  1265.          cmp32:=getregister32;
  1266.          case hs of
  1267.             1 : begin
  1268.                    opsize:=S_B;
  1269.                 end;
  1270.             2 : begin
  1271.                    opsize:=S_W;
  1272.                 end;
  1273.             4 : opsize:=S_L;
  1274.          end;
  1275.  
  1276.      { produce comparison and the corresponding }
  1277.      { jump                                     }
  1278.          if temptovalue then
  1279.            begin
  1280.               if p^.t2^.location.loc=LOC_CREGISTER then
  1281.                 begin
  1282.                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
  1283.                      p^.t2^.location.register)));
  1284.                 end
  1285.               else
  1286.                 begin
  1287.                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
  1288.                      cmpreg)));
  1289.                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
  1290.                      cmpreg)));
  1291.                 end;
  1292.            end
  1293.          else
  1294.            begin
  1295.               if p^.t2^.location.loc=LOC_CREGISTER then
  1296.                 exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
  1297.                   p^.t2^.location.register)))
  1298.               else
  1299.                 exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
  1300.                   newreference(p^.t2^.location.reference))));
  1301.            end;
  1302.          if p^.backward then
  1303.            if count_var_is_signed then
  1304.              hop:=A_BLE
  1305.            else
  1306.              hop :=A_BLS
  1307.           else
  1308.             if count_var_is_signed then
  1309.               hop:=A_BGE
  1310.             else
  1311.                hop:=A_BCC;
  1312.          emitl(hop,aktbreaklabel);
  1313.          { according to count direction DEC or INC... }
  1314.          { must be after the test because of 0to 255 for bytes !! }
  1315.          if p^.backward then
  1316.            hop:=A_SUB
  1317.          else hop:=A_ADD;
  1318.  
  1319.          if p^.t2^.location.loc=LOC_CREGISTER then
  1320.            exprasmlist^.concat(new(pai68k,op_const_reg(hop,opsize,1,p^.t2^.location.register)))
  1321.          else
  1322.             exprasmlist^.concat(new(pai68k,op_const_ref(hop,opsize,1,newreference(p^.t2^.location.reference))));
  1323.          emitl(A_JMP,l3);
  1324.  
  1325.      { this is the break label: }
  1326.          emitl(A_LABEL,aktbreaklabel);
  1327.          ungetregister32(cmp32);
  1328.  
  1329.          if temptovalue then
  1330.            ungetiftemp(temp1);
  1331.  
  1332.          aktcontinuelabel:=oldclabel;
  1333.          aktbreaklabel:=oldblabel;
  1334.       end;
  1335.  
  1336.  
  1337.     procedure secondas(var p : ptree);
  1338.  
  1339.       var
  1340.          pushed : tpushed;
  1341.  
  1342.       begin
  1343.          secondpass(p^.left);
  1344.          { save all used registers }
  1345.          pushusedregisters(pushed,$ffff);
  1346.  
  1347.          { push instance to check: }
  1348.          case p^.left^.location.loc of
  1349.             LOC_REGISTER,LOC_CREGISTER:
  1350.               exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
  1351.                 S_L,p^.left^.location.register,R_SPPUSH)));
  1352.             LOC_MEM,LOC_REFERENCE:
  1353.               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
  1354.                 S_L,newreference(p^.left^.location.reference),R_SPPUSH)));
  1355.             else internalerror(100);
  1356.          end;
  1357.  
  1358.          { we doesn't modifiy the left side, we check only the type }
  1359.          set_location(p^.location,p^.left^.location);
  1360.  
  1361.          { generate type checking }
  1362.          secondpass(p^.right);
  1363.          case p^.right^.location.loc of
  1364.             LOC_REGISTER,LOC_CREGISTER:
  1365.               begin
  1366.                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
  1367.                    S_L,p^.right^.location.register,R_SPPUSH)));
  1368.                  ungetregister32(p^.right^.location.register);
  1369.               end;
  1370.             LOC_MEM,LOC_REFERENCE:
  1371.               begin
  1372.                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
  1373.                    S_L,newreference(p^.right^.location.reference),R_SPPUSH)));
  1374.                  del_reference(p^.right^.location.reference);
  1375.               end;
  1376.             else internalerror(100);
  1377.          end;
  1378.          emitcall('DO_AS',true);
  1379.          { restore register, this restores automatically the }
  1380.          { result                                            }
  1381.          popusedregisters(pushed);
  1382.       end;
  1383.  
  1384.  
  1385.     { generates the code for a raise statement }
  1386.     procedure secondraise(var p : ptree);
  1387.  
  1388.       var
  1389.          a : plabel;
  1390.  
  1391.       begin
  1392.          if assigned(p^.left) then
  1393.            begin
  1394.               { generate the address }
  1395.               if assigned(p^.right) then
  1396.                 begin
  1397.                    secondpass(p^.right);
  1398.                    if codegenerror then
  1399.                      exit;
  1400.                 end
  1401.               else
  1402.                 begin
  1403.                    getlabel(a);
  1404.                    emitl(A_LABEL,a);
  1405.                    exprasmlist^.concat(new(pai68k,
  1406.                      op_csymbol_reg(A_MOVE,S_L,newcsymbol(lab2str(a),0),R_SPPUSH)));
  1407.                 end;
  1408.               secondpass(p^.left);
  1409.               if codegenerror then
  1410.                 exit;
  1411.  
  1412.               case p^.left^.location.loc of
  1413.                  LOC_MEM,LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
  1414.                  LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  1415.                    p^.left^.location.register,R_SPPUSH)));
  1416.                  else Message(sym_e_type_mismatch);
  1417.               end;
  1418.               emitcall('DO_RAISE',true);
  1419.            end
  1420.          else
  1421.            emitcall('DO_RERAISE',true);
  1422.       end;
  1423.  
  1424.  
  1425.  
  1426.  
  1427.     { This routine needs to be further checked to see if it works correctly  }
  1428.     { because contrary to the intel version, all large set elements are read }
  1429.     { as 32-bit values, and then decomposed to find the correct byte.        }
  1430.  
  1431.     { CHECKED : Depending on the result size, if reference, a load may be    }
  1432.     { required on word, long or byte.                                        }
  1433.     procedure loadsetelement(var p : ptree);
  1434.  
  1435.       var
  1436.          hr : tregister;
  1437.          opsize : topsize;
  1438.  
  1439.       begin
  1440.          { copy the element in the d0.b register, slightly complicated }
  1441.          case p^.location.loc of
  1442.             LOC_REGISTER,
  1443.             LOC_CREGISTER : begin
  1444.                               hr:=p^.location.register;
  1445.                               emit_reg_reg(A_MOVE,S_L,hr,R_D0);
  1446.                               ungetregister32(hr);
  1447.                            end;
  1448.             else
  1449.                begin
  1450.                  { This is quite complicated, because of the endian on }
  1451.                  { the m68k!                                           }
  1452.                  opsize:=S_NO;
  1453.                  case integer(p^.resulttype^.savesize) of
  1454.                    1 : opsize:=S_B;
  1455.                    2 : opsize:=S_W;
  1456.                    4 : opsize:=S_L;
  1457.                  else
  1458.                    internalerror(19);
  1459.                  end;
  1460.                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
  1461.                     newreference(p^.location.reference),R_D0)));
  1462.                  exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1463.                     255,R_D0)));
  1464. {
  1465.                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  1466.                     newreference(p^.location.reference),R_D0)));        }
  1467. {                  exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1468.                     $ff,R_D0))); }
  1469.                   del_reference(p^.location.reference);
  1470.                end;
  1471.          end;
  1472.       end;
  1473.  
  1474.     { could be built into secondadd but it }
  1475.     { should be easy to read }
  1476.     procedure secondin(var p : ptree);
  1477.  
  1478.  
  1479.       type  Tsetpart=record
  1480.                 range:boolean;      {Part is a range.}
  1481.                 start,stop:byte;    {Start/stop when range; Stop=element
  1482.                                      when an element.}
  1483.             end;
  1484.  
  1485.       var
  1486.          pushed,ranges : boolean;
  1487.          hr : tregister;
  1488.          setparts:array[1..8] of Tsetpart;
  1489.          i,numparts:byte;
  1490.          href,href2:Treference;
  1491.          l,l2 : plabel;
  1492.          hl,hl1 : plabel;
  1493.          hl2, hl3: plabel;
  1494.          opsize : topsize;
  1495.  
  1496.  
  1497.                function swaplongint(l : longint): longint;
  1498.                var
  1499.                  w1: word;
  1500.                  w2: word;
  1501.                begin
  1502.                  w1:=l and $ffff;
  1503.                  w2:=l shr 16;
  1504.                  l:=swap(w2)+(longint(swap(w1)) shl 16);
  1505.                  swaplongint:=l;
  1506.                end;
  1507.  
  1508.             function analizeset(Aset:Pconstset):boolean;
  1509.  
  1510.             type    byteset=set of byte;
  1511.                     tlongset  = array[0..7] of longint;
  1512.             var compares,maxcompares:word;
  1513.                 someset : tlongset;
  1514.                 i:byte;
  1515.  
  1516.             begin
  1517.                 analizeset:=false;
  1518.                 ranges:=false;
  1519.                 numparts:=0;
  1520.                 compares:=0;
  1521.                 {Lots of comparisions take a lot of time, so do not allow
  1522.                  too much comparisions. 8 comparisions are, however, still
  1523.                  smalller than emitting the set.}
  1524.                 maxcompares:=5;
  1525.                 if cs_littlesize in aktswitches then
  1526.                     maxcompares:=8;
  1527.                 move(ASet^,someset,32);
  1528.                 { On Big endian machines sets are stored   }
  1529.                 { as INTEL Little-endian format, therefore }
  1530.                 { we must convert it to the correct format }
  1531. {$IFDEF BIG_ENDIAN}
  1532.                 for I:=0 to 7 do
  1533.                   someset[i]:=swaplongint(someset[i]);
  1534. {$ENDIF}
  1535.                 for i:=0 to 255 do
  1536.                     if i in byteset(someset) then
  1537.                         begin
  1538.                             if (numparts=0) or
  1539.                              (i<>setparts[numparts].stop+1) then
  1540.                                 begin
  1541.                                     {Set element is a separate element.}
  1542.                                     inc(compares);
  1543.                                     if compares>maxcompares then
  1544.                                         exit;
  1545.                                     inc(numparts);
  1546.                                     setparts[numparts].range:=false;
  1547.                                     setparts[numparts].stop:=i;
  1548.                                 end
  1549.                              else
  1550.                                 {Set element is part of a range.}
  1551.                                 if not setparts[numparts].range then
  1552.                                     begin
  1553.                                         {Transform an element into a range.}
  1554.                                         setparts[numparts].range:=true;
  1555.                                         setparts[numparts].start:=
  1556.                                          setparts[numparts].stop;
  1557.                                         setparts[numparts].stop:=i;
  1558.                                         inc(compares);
  1559.                                         if compares>maxcompares then
  1560.                                             exit;
  1561.                                     end
  1562.                                 else
  1563.                                     begin
  1564.                                         {Extend a range.}
  1565.                                         setparts[numparts].stop:=i;
  1566.                                         {A range of two elements can better
  1567.                                          be checked as two separate ones.
  1568.                                          When extending a range, our range
  1569.                                          becomes larger than two elements.}
  1570.                                         ranges:=true;
  1571.                                     end;
  1572.                         end;
  1573.                 analizeset:=true;
  1574.             end;  { end analizeset }
  1575.  
  1576.       begin
  1577.          if psetdef(p^.right^.resulttype)^.settype=smallset then
  1578.            begin
  1579.               if p^.left^.treetype=ordconstn then
  1580.                 begin
  1581.                    { only compulsory }
  1582.                    secondpass(p^.left);
  1583.                    secondpass(p^.right);
  1584.                    if codegenerror then
  1585.                      exit;
  1586.                    p^.location.resflags:=F_NE;
  1587.                    { Because of the Endian of the m68k, we have to consider this as a  }
  1588.                    { normal set and load it byte per byte, otherwise we will never get }
  1589.                    { the correct result.                                               }
  1590.                    case p^.right^.location.loc of
  1591.                      LOC_REGISTER,LOC_CREGISTER :
  1592.                        begin
  1593.                          emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
  1594.                          exprasmlist^.concat(new(pai68k,
  1595.                            op_const_reg(A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
  1596.                        end;
  1597.                    else
  1598.                        begin
  1599.                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
  1600.                            p^.right^.location.reference),R_D1)));
  1601.                          exprasmlist^.concat(new(pai68k,op_const_reg(
  1602.                            A_AND,S_L,1 shl (p^.left^.value and 31) ,R_D1)));
  1603.                        end;
  1604.                    end;
  1605.                    del_reference(p^.right^.location.reference);
  1606.                 end
  1607.               else
  1608.                 begin
  1609.                    { calculate both operators }
  1610.                    { the complex one first }
  1611.                    firstcomplex(p);
  1612.                    secondpass(p^.left);
  1613.                    { are too few registers free? }
  1614.                    pushed:=maybe_push(p^.right^.registers32,p^.left);
  1615.                    secondpass(p^.right);
  1616.                    if pushed then
  1617.                      restore(p^.left);
  1618.                    { of course not commutative }
  1619.                    if p^.swaped then
  1620.                         swaptree(p);
  1621.                    { load index into register }
  1622.                    case p^.left^.location.loc of
  1623.                       LOC_REGISTER,
  1624.                       LOC_CREGISTER :
  1625.                           hr:=p^.left^.location.register;
  1626.                       else
  1627.                          begin
  1628.                             { Small sets are always 32 bit values, there is no  }
  1629.                             { way they can be anything else, so no problems here}
  1630.                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  1631.                               newreference(p^.left^.location.reference),R_D1)));
  1632.                             hr:=R_D1;
  1633.                             del_reference(p^.left^.location.reference);
  1634.                          end;
  1635.                    end;
  1636.                    case p^.right^.location.loc of
  1637.                       LOC_REGISTER,
  1638.                       LOC_CREGISTER : exprasmlist^.concat(new(pai68k, op_reg_reg(A_BTST,S_L,hr,p^.right^.location.register)));
  1639.                       else
  1640.                          begin
  1641.                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
  1642.                               R_D0)));
  1643.                             exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,hr,R_D0)));
  1644.                             del_reference(p^.right^.location.reference);
  1645.                          end;
  1646.                    end;
  1647.                    { support carry routines }
  1648.                    { sets the carry flags according to the result of BTST }
  1649.                    { i.e the Z flag.                                      }
  1650.                    getlabel(hl);
  1651.                    emitl(A_BNE,hl);
  1652.                    { leave all bits unchanged except Carry  = 0 }
  1653.                    exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B, $FE, R_CCR)));
  1654.                    getlabel(hl1);
  1655.                    emitl(A_BRA,hl1);
  1656.                    emitl(A_LABEL, hl);
  1657.                    { set carry to 1 }
  1658.                    exprasmlist^.concat(new(pai68k, op_const_reg(A_OR, S_B, $01, R_CCR)));
  1659.                    emitl(A_LABEL, hl1);
  1660.                    { end support carry routines }
  1661.                    p^.location.loc:=LOC_FLAGS;
  1662.                    p^.location.resflags:=F_C;
  1663.                 end;
  1664.            end
  1665.          else { //// NOT a small set  //// }
  1666.            begin
  1667.               if p^.left^.treetype=ordconstn then
  1668.                 begin
  1669.                    { only compulsory }
  1670.                    secondpass(p^.left);
  1671.                    secondpass(p^.right);
  1672.                    if codegenerror then
  1673.                      exit;
  1674.                    p^.location.resflags:=F_NE;
  1675.                    inc(p^.right^.location.reference.offset,(p^.left^.value div 32)*4);
  1676.                    exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L,
  1677.                        newreference(p^.right^.location.reference), R_D1)));
  1678.                    exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_L,
  1679.                        1 shl (p^.left^.value mod 32),R_D1)));
  1680.                    del_reference(p^.right^.location.reference);
  1681.                 end
  1682.              else
  1683.                 begin
  1684.                   if (p^.right^.treetype=setconstrn) and
  1685.                      analizeset(p^.right^.constset) then
  1686.                     begin
  1687.                       {It gives us advantage to check for the set elements
  1688.                         separately instead of using the SET_IN_BYTE procedure.
  1689.                        To do: Build in support for LOC_JUMP.}
  1690.                       secondpass(p^.left);
  1691.                       {We won't do a second pass on p^.right, because
  1692.                       this will emit the constant set.}
  1693.                       case p^.left^.location.loc of
  1694.                         LOC_REGISTER,
  1695.                         LOC_CREGISTER :
  1696.                            exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1697.                              255,p^.left^.location.register)));
  1698.                         else
  1699.                          Begin
  1700.                            { Because of the m68k endian, then we must LOAD normally the    }
  1701.                            { value into a register first, all depending on the source      }
  1702.                            { size!                                                         }
  1703.                            opsize:=S_NO;
  1704.                            case integer(p^.left^.resulttype^.savesize) of
  1705.                              1 : opsize:=S_B;
  1706.                              2 : opsize:=S_W;
  1707.                              4 : opsize:=S_L;
  1708.                            else
  1709.                              internalerror(19);
  1710.                            end;
  1711.                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
  1712.                              newreference(p^.left^.location.reference),R_D0)));
  1713.                            exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1714.                              255,R_D0)));
  1715.                          end;
  1716.                       end;
  1717.                       {Get a label to jump to the end.}
  1718.                       p^.location.loc:=LOC_FLAGS;
  1719.                       {It's better to use the zero flag when there are no ranges.}
  1720.                       if ranges then
  1721.                         p^.location.resflags:=F_C
  1722.                       else
  1723.                         p^.location.resflags:=F_E;
  1724.                       href.symbol := nil;
  1725.                       clear_reference(href);
  1726.                       getlabel(l);
  1727.                       href.symbol:=stringdup(lab2str(l));
  1728.                       for i:=1 to numparts do
  1729.                           if setparts[i].range then
  1730.                              begin
  1731.                                   {Check if left is in a range.}
  1732.                                   {Get a label to jump over the check.}
  1733.                                   href2.symbol := nil;
  1734.                                   clear_reference(href2);
  1735.                                   getlabel(l2);
  1736.                                   href.symbol:=stringdup(lab2str(l2));
  1737.                                   if setparts[i].start=setparts[i].stop-1 then
  1738.                                   begin
  1739.                                     case p^.left^.location.loc of
  1740.                                       LOC_REGISTER,
  1741.                                       LOC_CREGISTER :
  1742.                                          exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1743.                                            setparts[i].start,p^.left^.location.register)));
  1744.                                     else
  1745.                                          exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1746.                                            setparts[i].start,R_D0)));
  1747. {                                         exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  1748.                                            setparts[i].start,newreference(p^.left^.location.reference))));}
  1749.                                     end;
  1750.                                   {Result should be in carry flag when ranges are used.}
  1751.                                   { Here the m68k does not affect any flag except the  }
  1752.                                   { flag which is OR'ed                                }
  1753.                                   if ranges then
  1754.                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
  1755.                                   {If found, jump to end.}
  1756.                                   emitl(A_BEQ,l);
  1757.                                   case p^.left^.location.loc of
  1758.                                     LOC_REGISTER,
  1759.                                     LOC_CREGISTER :
  1760.                                       exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1761.                                         setparts[i].stop,p^.left^.location.register)));
  1762.                                     else
  1763.                                       exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1764.                                         setparts[i].stop,R_D0)));
  1765. {                                      exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  1766.                                       setparts[i].stop,newreference(p^.left^.location.reference))));}
  1767.                                   end;
  1768.                                   {Result should be in carry flag when ranges are used.}
  1769.                                   { Here the m68k does not affect any flag except the  }
  1770.                                   { flag which is OR'ed                                }
  1771.                                   if ranges then
  1772.                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
  1773.                                   {If found, jump to end.}
  1774.                                   emitl(A_BEQ,l);
  1775.                              end
  1776.                           else
  1777.                              begin
  1778.                                if setparts[i].start<>0 then
  1779.                                   begin
  1780.                                   {We only check for the lower bound if it is > 0, because
  1781.                                    set elements lower than 0 do nt exist.}
  1782.                                     case p^.left^.location.loc of
  1783.                                       LOC_REGISTER,
  1784.                                       LOC_CREGISTER :
  1785.                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1786.                                         setparts[i].start,p^.left^.location.register)));
  1787.                                     else
  1788.                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1789.                                         setparts[i].start,R_D0)));
  1790. {                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  1791.                                         setparts[i].start,newreference(p^.left^.location.reference)))); }
  1792.                                     end;
  1793.                                     {If lower, jump to next check.}
  1794.                                     emitl(A_BCS,l2);
  1795.                                     end;
  1796.                                     if setparts[i].stop<>255 then
  1797.                                        begin
  1798.                                        {We only check for the high bound if it is < 255, because
  1799.                                           set elements higher than 255 do nt exist.}
  1800.                                           case p^.left^.location.loc of
  1801.                                             LOC_REGISTER,
  1802.                                             LOC_CREGISTER :
  1803.                                               exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1804.                                                 setparts[i].stop+1,p^.left^.location.register)));
  1805.                                           else
  1806.                                               exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1807.                                                 setparts[i].stop+1,R_D0)));
  1808. {                                              exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  1809.                                                 setparts[i].stop+1,newreference(p^.left^.location.reference))));}
  1810.                                           end; { end case }
  1811.                                           {If higher, element is in set.}
  1812.                                           emitl(A_BCS,l);
  1813.                                        end
  1814.                                      else
  1815.                                        begin
  1816.                                          exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
  1817.                                          emitl(A_JMP,l);
  1818.                                        end;
  1819.                                   end;
  1820.                                {Emit the jump over label.}
  1821.                                exprasmlist^.concat(new(pai_label,init(l2)));
  1822.                              end
  1823.                             else
  1824.                                begin
  1825.                                {Emit code to check if left is an element.}
  1826.                                  case p^.left^.location.loc of
  1827.                                    LOC_REGISTER,
  1828.                                    LOC_CREGISTER :
  1829.                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1830.                                       setparts[i].stop,p^.left^.location.register)));
  1831.                                    else
  1832. {                                     exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
  1833.                                      setparts[i].stop,newreference(p^.left^.location.reference))));}
  1834.                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
  1835.                                       setparts[i].stop,R_D0)));
  1836.                                    end;
  1837.                                  {Result should be in carry flag when ranges are used.}
  1838.                                  if ranges then
  1839.                                    exprasmlist^.concat(new(pai68k, op_const_reg(A_OR,S_B,$01,R_CCR)));
  1840.                                    {If found, jump to end.}
  1841.                                  emitl(A_BEQ,l);
  1842.                                end;
  1843.                             if ranges then
  1844.                             { clear carry flag }
  1845.                                 exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,$FE,R_CCR)));
  1846.                             {To compensate for not doing a second pass.}
  1847.                             stringdispose(p^.right^.location.reference.symbol);
  1848.                             {Now place the end label.}
  1849.                             exprasmlist^.concat(new(pai_label,init(l)));
  1850.                         end
  1851.                    else
  1852.                         begin
  1853.                            { calculate both operators }
  1854.                            { the complex one first }
  1855.                            firstcomplex(p);
  1856.                            secondpass(p^.left);
  1857.                            set_location(p^.location,p^.left^.location);
  1858.                            { are too few registers free? }
  1859.                            pushed:=maybe_push(p^.right^.registers32,p);
  1860.                            secondpass(p^.right);
  1861.                            if pushed then restore(p);
  1862.                            { of course not commutative }
  1863.                            if p^.swaped then
  1864.                              swaptree(p);
  1865.                             { SET_IN_BYTE is an inline assembler procedure instead  }
  1866.                             { of a normal procedure, which is *MUCH* faster         }
  1867.                             { Parameters are passed by registers, and FLAGS are set }
  1868.                             { according to the result.                              }
  1869.                             { a0   = address of set                                 }
  1870.                             { d0.b = value to compare with                          }
  1871.                             { CARRY SET IF FOUND ON EXIT                            }
  1872.                             loadsetelement(p^.left);
  1873.                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  1874.                               newreference(p^.right^.location.reference),R_A0)));;
  1875. {                            emitpushreferenceaddr(p^.right^.location.reference);}
  1876.                             del_reference(p^.right^.location.reference);
  1877.                             emitcall('SET_IN_BYTE',true);
  1878.                             { ungetiftemp(p^.right^.location.reference); }
  1879.                             p^.location.loc:=LOC_FLAGS;
  1880.                             p^.location.resflags:=F_C;
  1881.                         end;
  1882.                 end;
  1883.              end;
  1884.       end;
  1885.  
  1886.  
  1887.  
  1888.     procedure secondexpr(var p : ptree);
  1889.  
  1890.       begin
  1891.          secondpass(p^.left);
  1892.       end;
  1893.  
  1894.     procedure secondblockn(var p : ptree);
  1895.  
  1896.       var
  1897.          hp : ptree;
  1898.  
  1899.       begin
  1900.          hp:=p^.left;
  1901.          while assigned(hp) do
  1902.            begin
  1903.               { assignments could be distance optimized }
  1904.               if assigned(hp^.right) then
  1905.                 begin
  1906.                    cleartempgen;
  1907.                    secondpass(hp^.right);
  1908.                 end;
  1909.               hp:=hp^.left;
  1910.            end;
  1911.       end;
  1912.  
  1913.     procedure second_while_repeatn(var p : ptree);
  1914.  
  1915.       var
  1916.          l1,l2,l3,oldclabel,oldblabel : plabel;
  1917.          otlabel,oflabel : plabel;
  1918.       begin
  1919.          getlabel(l1);
  1920.          getlabel(l2);
  1921.          { arrange continue and breaklabels: }
  1922.          oldclabel:=aktcontinuelabel;
  1923.          oldblabel:=aktbreaklabel;
  1924.          if p^.treetype=repeatn then
  1925.            begin
  1926.               emitl(A_LABEL,l1);
  1927.               aktcontinuelabel:=l1;
  1928.               aktbreaklabel:=l2;
  1929.               cleartempgen;
  1930.               if assigned(p^.right) then
  1931.                secondpass(p^.right);
  1932.  
  1933.               otlabel:=truelabel;
  1934.               oflabel:=falselabel;
  1935.               truelabel:=l2;
  1936.               falselabel:=l1;
  1937.               cleartempgen;
  1938.               secondpass(p^.left);
  1939.               maketojumpbool(p^.left);
  1940.               emitl(A_LABEL,l2);
  1941.               truelabel:=otlabel;
  1942.               falselabel:=oflabel;
  1943.            end
  1944.          else
  1945.            begin
  1946.               { handling code at the end as it is much more efficient }
  1947.               emitl(A_JMP,l2);
  1948.  
  1949.               emitl(A_LABEL,l1);
  1950.               cleartempgen;
  1951.  
  1952.               getlabel(l3);
  1953.               aktcontinuelabel:=l2;
  1954.               aktbreaklabel:=l3;
  1955.  
  1956.               if assigned(p^.right) then
  1957.                secondpass(p^.right);
  1958.  
  1959.               emitl(A_LABEL,l2);
  1960.               otlabel:=truelabel;
  1961.               oflabel:=falselabel;
  1962.               truelabel:=l1;
  1963.               falselabel:=l3;
  1964.               cleartempgen;
  1965.               secondpass(p^.left);
  1966.               maketojumpbool(p^.left);
  1967.  
  1968.               emitl(A_LABEL,l3);
  1969.               truelabel:=otlabel;
  1970.               falselabel:=oflabel;
  1971.            end;
  1972.          aktcontinuelabel:=oldclabel;
  1973.          aktbreaklabel:=oldblabel;
  1974.       end;
  1975.  
  1976.     procedure secondifn(var p : ptree);
  1977.  
  1978.       var
  1979.          hl,otlabel,oflabel : plabel;
  1980.  
  1981.       begin
  1982.          otlabel:=truelabel;
  1983.          oflabel:=falselabel;
  1984.          getlabel(truelabel);
  1985.          getlabel(falselabel);
  1986.          cleartempgen;
  1987.          secondpass(p^.left);
  1988.          maketojumpbool(p^.left);
  1989.          if assigned(p^.right) then
  1990.            begin
  1991.               emitl(A_LABEL,truelabel);
  1992.               cleartempgen;
  1993.               secondpass(p^.right);
  1994.            end;
  1995.          if assigned(p^.t1) then
  1996.            begin
  1997.               if assigned(p^.right) then
  1998.                 begin
  1999.                    getlabel(hl);
  2000.                    emitl(A_JMP,hl);
  2001.                 end;
  2002.               emitl(A_LABEL,falselabel);
  2003.               cleartempgen;
  2004.               secondpass(p^.t1);
  2005.               if assigned(p^.right) then
  2006.                 emitl(A_LABEL,hl);
  2007.            end
  2008.          else
  2009.            emitl(A_LABEL,falselabel);
  2010.          if not(assigned(p^.right)) then
  2011.            emitl(A_LABEL,truelabel);
  2012.          truelabel:=otlabel;
  2013.          falselabel:=oflabel;
  2014.       end;
  2015.  
  2016.     procedure secondbreakn(var p : ptree);
  2017.  
  2018.       begin
  2019.          if aktbreaklabel<>nil then
  2020.            emitl(A_JMP,aktbreaklabel)
  2021.          else
  2022.            Message(cg_e_break_not_allowed);
  2023.       end;
  2024.  
  2025.  
  2026. end.
  2027. {
  2028.   $Log: cg68k2.pas,v $
  2029.   Revision 1.2.2.5  1998/08/18 13:51:45  carl
  2030.     + added BIg endian support for analizeset
  2031.  
  2032.   Revision 1.2.2.4  1998/07/29 12:15:53  carl
  2033.     * bug0130, bug0134, and bug0129 fixed
  2034.  
  2035.   Revision 1.2.2.3  1998/07/21 12:16:20  carl
  2036.     * EOR bugfix, must be loaded into a register..
  2037.     * secondin bugfix, we must load using the resulttype opsize
  2038.     * loadsetelement, if ref, then we must load depending on the operand size
  2039.  
  2040.   Revision 1.2  1998/03/28 23:09:54  florian
  2041.     * secondin bugfix (m68k and i386)
  2042.     * overflow checking bugfix (m68k and i386) -- pretty useless in
  2043.       secondadd, since everything is done using 32-bit
  2044.     * loading pointer to routines hopefully fixed (m68k)
  2045.     * flags problem with calls to RTL internal routines fixed (still strcmp
  2046.       to fix) (m68k)
  2047.     * #ELSE was still incorrect (didn't take care of the previous level)
  2048.     * problem with filenames in the command line solved
  2049.     * problem with mangledname solved
  2050.     * linking name problem solved (was case insensitive)
  2051.     * double id problem and potential crash solved
  2052.     * stop after first error
  2053.     * and=>test problem removed
  2054.     * correct read for all float types
  2055.     * 2 sigsegv fixes and a cosmetic fix for Internal Error
  2056.     * push/pop is now correct optimized (=> mov (%esp),reg)
  2057.  
  2058.   Revision 1.1.1.1  1998/03/25 11:18:13  root
  2059.   * Restored version
  2060.  
  2061.   Revision 1.18  1998/03/10 01:17:15  peter
  2062.     * all files have the same header
  2063.     * messages are fully implemented, EXTDEBUG uses Comment()
  2064.     + AG... files for the Assembler generation
  2065.  
  2066.   Revision 1.17  1998/03/09 10:44:34  peter
  2067.     + string='', string<>'', string:='', string:=char optimizes (the first 2
  2068.       were already in cg68k2)
  2069.  
  2070.   Revision 1.16  1998/03/06 00:52:02  peter
  2071.     * replaced all old messages from errore.msg, only ExtDebug and some
  2072.       Comment() calls are left
  2073.     * fixed options.pas
  2074.  
  2075.   Revision 1.15  1998/03/02 01:48:15  peter
  2076.     * renamed target_DOS to target_GO32V1
  2077.     + new verbose system, merged old errors and verbose units into one new
  2078.       verbose.pas, so errors.pas is obsolete
  2079.  
  2080.   Revision 1.14  1998/02/14 05:05:43  carl
  2081.     + now compiles under TP with overlays
  2082.  
  2083.   Revision 1.13  1998/02/13 10:34:44  daniel
  2084.   * Made Motorola version compilable.
  2085.   * Fixed optimizer
  2086.  
  2087.   Revision 1.12  1998/02/12 11:49:49  daniel
  2088.   Yes! Finally! After three retries, my patch!
  2089.  
  2090.   Changes:
  2091.  
  2092.   Complete rewrite of psub.pas.
  2093.   Added support for DLL's.
  2094.   Compiler requires less memory.
  2095.   Platform units for each platform.
  2096.  
  2097.   Revision 1.11  1998/02/07 06:51:51  carl
  2098.     + moved secondraise from cg68k
  2099.  
  2100.   Revision 1.10  1998/02/05 21:54:31  florian
  2101.     + more MMX
  2102.  
  2103.   Revision 1.9  1998/02/05 00:59:29  carl
  2104.     + added secondas
  2105.  
  2106.   Revision 1.8  1998/02/01 17:13:26  florian
  2107.     + comparsion of class references
  2108.  
  2109.   Revision 1.7  1998/01/21 22:34:23  florian
  2110.     + comparsion of Delphi classes
  2111.  
  2112.   Revision 1.6  1998/01/11 03:37:18  carl
  2113.   * bugfix of muls.l under MC68000 target
  2114.   * long subtract bugfix
  2115.  
  2116.   Revision 1.3  1997/12/10 23:07:15  florian
  2117.   * bugs fixed: 12,38 (also m68k),39,40,41
  2118.   + warning if a system unit is without -Us compiled
  2119.   + warning if a method is virtual and private (was an error)
  2120.   * some indentions changed
  2121.   + factor does a better error recovering (omit some crashes)
  2122.   + problem with @type(x) removed (crashed the compiler)
  2123.  
  2124.   Revision 1.2  1997/12/04 15:15:05  carl
  2125.   + updated to v099.
  2126.  
  2127.   Revision 1.1.1.1  1997/11/27 08:32:53  michael
  2128.   FPC Compiler CVS start
  2129.  
  2130.  
  2131.   Pre-CVS log:
  2132.  
  2133.  
  2134.   FK     Florian Klaempfl
  2135.   +      feature added
  2136.   -      removed
  2137.   *      bug fixed or changed
  2138.  
  2139.   History:
  2140.        8th october 1997:
  2141.          + only a cmpb $0,_S is generated if s is a string and a
  2142.            s='' or s<>'' is performed (FK)
  2143.       17th october 1997:
  2144.          + unit started (CEC)
  2145.  
  2146. }
  2147.